home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / network / info-sys / www / tkhtml-2.3 / tkhtml-2 / tkHTML-2.3 / tix / NewBind.tcl < prev    next >
Encoding:
Text File  |  1995-02-12  |  7.0 KB  |  343 lines
  1. proc tixClassBindAutoScroll {w time unit limit func} {
  2.   global tix_priv
  3.   set tix_priv(as_ignore) 0 
  4.   set tix_priv(as_state)  STOPPED
  5.   set tix_priv(as_loaded) yes
  6.  
  7.   bind $w <B1-Leave>     "+tixAutoS_Start  %W $time $unit $limit $func %x %y"
  8.   bind $w <B1-Motion>    "+tixAutoS_Motion %W $time $func %x %y"
  9.   bind $w <B1-Enter>         "+tixAutoS_Stop %W"
  10.   bind $w <ButtonRelease-1>  "+tixAutoS_Stop %W"
  11. }
  12.  
  13. proc tixWidgetBindAutoScroll {w class} {
  14.     global tix_priv
  15.     set tix_priv(as_ignore) 0 
  16.     set tix_priv(as_state)  STOPPED
  17.  
  18.     bind $w <B1-Leave>         "+[bind $class <B1-Leave>]"
  19.     bind $w <B1-Enter>         "+[bind $class <B1-Enter>]"
  20.     bind $w <B1-Motion>        "+[bind $class <B1-Motion>]"
  21.     bind $w <ButtonRelease-1>  "+[bind $class <ButtonRelease-1>]"
  22. }
  23.  
  24. proc tixAutoS_Start {w time unit limit func x y} {
  25.     global tix_priv
  26.  
  27.     set tix_priv(as_xcount) 0
  28.     set tix_priv(as_ycount) 0
  29.     set tix_priv(as_state)  STARTED
  30.     set tix_priv(as_width)  [winfo width  $w]
  31.     set tix_priv(as_height) [winfo height $w]
  32.     set tix_priv(as_unit)   $unit
  33.     set tix_priv(as_limit)  $limit
  34.  
  35.     if {$tix_priv(as_ignore) == 0} {
  36.     tixAutoS_Calc $w $x $y
  37.     tixAutoS_ReSend $w $time $func
  38.     } else {
  39.     puts conf
  40.     }
  41. }
  42.  
  43. proc tixAutoS_Stop {w} {
  44.     global tix_priv
  45.  
  46.     set tix_priv(as_state) STOPPED
  47. }
  48.  
  49. proc tixAutoS_Motion {w time func x y} {
  50.     global tix_priv
  51.  
  52.     if {$tix_priv(as_state) != "STOPPED"} {
  53.        tixAutoS_Calc $w $x $y
  54.        tixAutoS_Send $w $func
  55.     }
  56. }
  57.  
  58. proc tixAutoS_Send {w func} {
  59.     global tix_priv
  60.  
  61.     if {$tix_priv(as_dx) < $tix_priv(as_unit)} {
  62.     incr tix_priv(as_xcount) $tix_priv(as_dx)
  63.     if {$tix_priv(as_xcount) >= $tix_priv(as_unit)} {
  64.         set dx 1
  65.         set tix_priv(as_xcount) 0
  66.     } else {
  67.         set dx 0
  68.     }
  69.     } else {
  70.     set dx [expr "$tix_priv(as_dx) / $tix_priv(as_unit)"]
  71.     }
  72.  
  73.     if {$tix_priv(as_dy) < $tix_priv(as_unit)} {
  74.     incr tix_priv(as_ycount) $tix_priv(as_dy)
  75.     if {$tix_priv(as_ycount) >= $tix_priv(as_unit)} {
  76.         set dy 1
  77.         set tix_priv(as_ycount) 0
  78.     } else {
  79.         set dy 0
  80.     }
  81.     } else {
  82.     set dy [expr "$tix_priv(as_dy) / $tix_priv(as_unit)"]
  83.     }
  84.  
  85.     if {$dx > $tix_priv(as_limit)} {
  86.     set dx $tix_priv(as_limit)
  87.     }
  88.     if {$dy > $tix_priv(as_limit)} {
  89.     set dy $tix_priv(as_limit)
  90.     }
  91.  
  92.     eval $func $w $tix_priv(as_dir) $dx $dy
  93.  
  94. }
  95.  
  96. proc tixAutoS_ReSend {w time func} {
  97.     global tix_priv
  98.  
  99.     if {$tix_priv(as_state) != "STOPPED"} {
  100.     tixAutoS_Send $w $func
  101.     after $time tixAutoS_ReSend $w $time $func
  102.     }
  103. }
  104.  
  105. proc tixAutoS_Calc {w x y} {
  106.     global tix_priv
  107.  
  108.     if {$x <= 0} {
  109.     if {$y <= 0} {
  110.         set tix_priv(as_dir) nw
  111.     } elseif {$y >= $tix_priv(as_height)} {
  112.         set tix_priv(as_dir) sw
  113.     } else {
  114.         set tix_priv(as_dir) w
  115.     }
  116.     } elseif {$x >= $tix_priv(as_width)} {
  117.     if {$y <= 0} {
  118.         set tix_priv(as_dir) ne
  119.     } elseif {$y >= $tix_priv(as_height)} {
  120.         set tix_priv(as_dir) se
  121.     } else {
  122.         set tix_priv(as_dir) e
  123.     }
  124.     } elseif {$y <= 0} {
  125.     set tix_priv(as_dir) n
  126.     } elseif {$y >= $tix_priv(as_height)} {
  127.     set tix_priv(as_dir) s
  128.     } else {
  129.     set tix_priv(as_dir) c
  130.     }
  131.  
  132.     if {$x <= 0} {
  133.     set dx [expr "0 - $x"]
  134.     } elseif {$x >= $tix_priv(as_width)} {
  135.     set dx [expr "$x - $tix_priv(as_width)"]
  136.     } else {
  137.     set dx 0
  138.     }
  139.  
  140.     if [catch {set tix_priv(as_dx) [expr "round($dx * log($dx))"]}] {
  141.     set tix_priv(as_dx) 0
  142.     }
  143.  
  144.     if {$y <= 0} {
  145.     set dy [expr "0 - $y"]
  146.     } elseif {$y >= $tix_priv(as_height)} {
  147.     set dy [expr "$y - $tix_priv(as_height)"]
  148.     } else {
  149.     set dy 0
  150.     }
  151.  
  152.     if [catch {set tix_priv(as_dy) [expr "round($dy * log($dy))"]}] {
  153.     set tix_priv(as_dy) 0
  154.     }
  155. }
  156.  
  157. proc tixAutoS_Update {} {
  158.     global tix_priv
  159.  
  160.     set tix_priv(as_ignore) 1
  161.     update idletasks
  162.     set tix_priv(as_ignore) 0
  163. }
  164.  
  165. #----------------------------------------------------------------------
  166. # Scroll for text
  167. #----------------------------------------------------------------------
  168. proc tixAutoS_Text {w dir dx dy} {
  169.     global tix_priv
  170.  
  171.     if {$dy == 0} {
  172.     return
  173.     }
  174.  
  175.     case $dir {
  176.     {n nw ne} {
  177.         tk_textSelectTo $w "@0,0 -$dy line"
  178.         $w yview [$w index "@0,0 -$dy line"]
  179.         tixAutoS_Update
  180.     }
  181.     {s sw se} {
  182.         tk_textSelectTo $w \
  183.         "@$tix_priv(as_width),$tix_priv(as_height) +$dy line"
  184.         $w yview [$w index "@0,0 +$dy line"]
  185.         tixAutoS_Update
  186.     }
  187.     }
  188. }
  189.  
  190. proc tixAutoS_Entry {w dir dx dy} {
  191.     global tix_priv
  192.  
  193.     if {$dx == 0} {
  194.     return
  195.     }
  196.  
  197.     case $dir {
  198.     {w nw sw} {
  199.         $w icursor [expr "[$w index insert] - $dx"]
  200.         $w select to insert
  201.         tk_entrySeeCaret $w
  202.         tixAutoS_Update
  203.     }
  204.     {e ne se} {
  205.         $w icursor [expr "[$w index insert] + $dx"]
  206.         $w select to insert
  207.         tk_entrySeeCaret $w
  208.         tixAutoS_Update
  209.     }
  210.     }
  211. }
  212.  
  213. proc tixAutoS_ListboxSingle {w dir dx dy} {
  214.     global tix_priv
  215.  
  216.  
  217.     case $dir {
  218.     {n} {
  219.         if {$dy == 0} {
  220.         return
  221.         }
  222.         set sel [expr "[$w nearest 0]-$dy"]
  223.         $w yview $sel
  224.         $w select from $sel
  225.         $w select to $sel
  226.         tixAutoS_Update    
  227.     }
  228.     {s} {
  229.         if {$dy == 0} {
  230.         return
  231.         }
  232.         set height [winfo height $w]
  233.         set sel [expr "[$w nearest $height]+$dy"]
  234.         $w yview [expr "[$w nearest 0]+$dy"]
  235.         $w select from $sel
  236.         $w select to $sel
  237.         tixAutoS_Update
  238.     }
  239.     {e} {
  240.  
  241.     }
  242.     {w} {
  243.  
  244.     }
  245.     }
  246. }
  247.  
  248. proc tixAutoS_Listbox {w dir dx dy} {
  249.     global tix_priv
  250.  
  251.     case $dir {
  252.     {n} {
  253.         if {$dy == 0} {
  254.         return
  255.         }
  256.         set sel [expr "[$w nearest 0]-$dy"]
  257.         $w yview $sel
  258.         $w select to $sel
  259.         tixAutoS_Update    
  260.     }
  261.     {s} {
  262.         if {$dy == 0} {
  263.         return
  264.         }
  265.         set height [winfo height $w]
  266.         set sel [expr "[$w nearest $height]+$dy"]
  267.         $w yview [expr "[$w nearest 0]+$dy"]
  268.         $w select to $sel
  269.         tixAutoS_Update
  270.     }
  271.     {e} {
  272.  
  273.     }
  274.     {w} {
  275.  
  276.     }
  277.     }
  278. }
  279.  
  280.  
  281. # New bindings
  282. proc tixDefaultAutoBind {} {
  283.     global tix_priv
  284.  
  285.     tixClassBindAutoScroll Entry \
  286.     $tix_priv(as_entRate) \
  287.     $tix_priv(as_entUnit) \
  288.     $tix_priv(as_entLimit)\
  289.     tixAutoS_Entry
  290.     tixClassBindAutoScroll Listbox \
  291.     $tix_priv(as_listRate) \
  292.     $tix_priv(as_listUnit) \
  293.     $tix_priv(as_listLimit)\
  294.     tixAutoS_Listbox
  295.     tixClassBindAutoScroll Text \
  296.     $tix_priv(as_textRate) \
  297.     $tix_priv(as_textUnit) \
  298.     $tix_priv(as_textLimit)\
  299.     tixAutoS_Text
  300. }
  301.  
  302. proc tixAutoS_BindListbox {w} {
  303.     tixWidgetBindAutoScroll $w Listbox
  304. }
  305.  
  306. proc tixAutoS_BindListboxSingle {w} {
  307.   global tix_priv
  308.  
  309.   set time $tix_priv(as_listRate)
  310.   set unit $tix_priv(as_listUnit)
  311.   set limit $tix_priv(as_listLimit)
  312.   set func tixAutoS_ListboxSingle
  313.  
  314.   set tix_priv(as_ignore) 0 
  315.   set tix_priv(as_state)  STOPPED
  316.   set tix_priv(as_loaded) yes
  317.  
  318.   bind $w <B1-Leave>     "+tixAutoS_Start  %W $time $unit $limit $func %x %y"
  319.   bind $w <B1-Motion>    "+tixAutoS_Motion %W $time $func %x %y"
  320.   bind $w <B1-Enter>         "+tixAutoS_Stop %W"
  321.   bind $w <ButtonRelease-1>  "+tixAutoS_Stop %W"
  322. }
  323.  
  324. proc tixAutoS_BindEntry {w} {
  325.     tixWidgetBindAutoScroll $w Entry
  326. }
  327.  
  328. proc tixAutoS_BindText {w} {
  329.     tixWidgetBindAutoScroll $w Text 30 tixAutoS_Text
  330. }
  331.  
  332. set tix_priv(as_listRate)  30
  333. set tix_priv(as_listUnit)  130
  334. set tix_priv(as_listLimit) 10
  335.  
  336. set tix_priv(as_textRate)  30
  337. set tix_priv(as_textUnit)  130
  338. set tix_priv(as_textLimit) 45
  339.  
  340. set tix_priv(as_entRate)   30
  341. set tix_priv(as_entUnit)   130
  342. set tix_priv(as_entLimit)  100
  343.